unit forthdaemon;

interface
uses
  sysutils,classes,
  httpd,
  blcksock,
{$IFDEF DELPHI}
  windows,
{$ENDIF}
  basetype,getoptlib,vm,forthhandler,inifiles;

function initialize_engine(inifile:string=''):TKsanaForthVM;
procedure mainloop(vm:TKsanaForthVM);

var
 debugging:boolean;
implementation

const
helpmsg='ksanaforthd [-p port]'+#13#10+
  ' -p  : specify port number of the daemon, default 8082'+#13#10;

var ConsoleClose,verbose:boolean;

procedure printhelp;
begin
  writeln(helpmsg);
end;

var
  run:string;
  port:integer;
  daemon:TTCPHttpDaemon;
  i,ch:integer;
 // slkey:TTntstringlist;
 //f:tSearchrec;
{
function getconsolehandle:thandle;
var
  pszOldWindowTitle:array[0..255] of char;
  uniquecap:string;
begin
  GetConsoleTitle(pszOldWindowTitle, 255);
  uniquecap:=format('%d/%d',[GetTickCount,GetCurrentProcessId]);
  SetConsoleTitle(pchar(uniquecap));
  Sleep(40);
  result:=FindWindow(nil, pchar(uniquecap));
  SetConsoleTitle(pszOldWindowTitle);

end;
}
function portoccupied(useport:string):boolean;
var
  sock:TTCPBlockSocket;
begin
//portoccupied:=false;// 960716sam
  sock:=TTCPBlockSocket.Create;
  sock.Connect('127.0.0.1',useport);
  result:=sock.LastError=0;
  sock.free;
end;

procedure inputcheck(vm:TKsanaForthvm);
begin
  vm.tos:=vm.tos;
end;
procedure ztype(vm:TKsanaForthvm;p:pchar);
begin
  write(p);
end;
procedure emit(vm:TKsanaForthvm;c:char);
begin
  if c=#13 then writeln('') else  write(c);
end;

//change the extension of a file
// if no extension then simply append
function changefilext(fn,ext:string):string;
var
  p,pdot,ppath:pchar;
begin
  p:=pchar(fn);
  pdot:=strRscan(p,'.');
  ppath:=strrscan(p,pathdelimiter);
  if (pdot<>nil) and (pdot>ppath) then begin
    result:=copy(fn,1, integer(pdot-p))+'.'+ext;
  end else begin
    result:=fn+'.'+ext;
  end;
end;
function initialize_engine(inifile:string=''):TKsanaForthVM;
var
  s,p:string;
  h:thandle;
  ini:tinifile;
  forth_preload:string;
begin
  i:=0;

  repeat if i>0 then s:=s+' '; s:=s+argvptr[i]; inc(i);
  until argvptr[i]='';
  writeln(s); // show command line info
  run:=''; port:=8080; ch:=0;
  while ch <> EOF_getopt do begin
    ch:=getopt(argc,argvptr^,'cp:f:'); //
    case ch of
      integer('c'):
        ConsoleClose:=true;
      integer('v'):
        verbose:=true;        
      integer('p'): begin
        p:=optarg;
        if portoccupied(p) then begin
          writeln ('PORT '+p+' occupied by other program, try other port');
          halt;
        end;
        port:=strtointdef(p,port); writeln('port '+p);
      end;
      integer(':'): writeln('Missing arg!');
      integer('?'): writeln('Unknown option!');
      EOF_getopt  : break;
    end;
  end;

  if inifile='' then inifile:=changefilext(expandfilename(paramstr(0)),'ini');
  ini:=tinifile.create(inifile);

  daemon:=TTCPHttpDaemon.create(port);
  daemon.documentroot := expandfilename(ini.ReadString('httpd','documentroot','.'));
  daemon.kdbroot := expandfilename(ini.ReadString('httpd','kdbroot','.'));
  forth_preload:=ini.readstring('httpd','preload','webcore.kf');

  daemon.init(port);

  writeln('Ksana Forth Daemon, ver: 1.1');
  writeln('press ^C to shutdown daemon');


  daemonengine:=TKsanaForthVM.create;
  daemonengine.tickinputcheck :=inputcheck;
  daemonengine.tickztype :=ztype;
  daemonengine.tickemit  :=emit;
  daemonengine.interactive:=true;
  daemonengine.reset;
  daemonengine.kdbroot := daemon.kdbroot;
  daemonengine.setasglobal;  // other engine may access to this voc


  if fileexists(forth_preload) then begin
     daemonengine.fload(forth_preload);
  end;
  result:= daemonengine;
  ini.free;
end;


procedure mainloop(vm:TKsanaForthVM);
var
  s:string;
begin
  s:='';
 // repeat
 //   readln(s);
 //   writeln(s);
 // until false;
  
 //   daemonengine.eval(s);
 // until daemonengine.quiting;
 if not debugging then
{$IFDEF WIN32}
  winexec(pchar('cmd /c START http://localhost:'+inttostr(daemon.port)+'/'),0);
{$ENDIF}
  repeat
    sleep(10000);
    if (verbose) then writeln('ksanad heart beat');
  until daemonengine.quiting;
  daemonengine.free;
  daemon.free;
end;



end.
